home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86jun.arc / MIDI.ARC / LIST5.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  3.6 KB  |  176 lines
  1.  
  2. { Fill in the message bytes of the current 
  3.   Track Event in a Track Data Block
  4. }
  5. procedure track_event_message(var tdt:track_data_block);
  6. var
  7.   i : byte;  { index counter }
  8. label
  9.   return;
  10. begin
  11. with tdt.curr do
  12.   begin
  13.   case this_byte(tdt) of
  14.     NOP, MEASURE_END, DATA_END:
  15.       begin
  16.       event_type:=MARK;
  17.       if (this_byte(tdt) = DATA_END) then
  18.     tdt.edat:=true;
  19.       event.mess[event_len]:=this_byte(tdt);
  20.       event_len:=event_len+1;
  21.       advance(tdt);
  22.       goto return;
  23.       end;
  24.     128..239: { MIDI status byte }
  25.       begin
  26.       running_status:=this_byte(tdt);
  27.       event_type:=MIDI_RS;
  28.       event.mess[event_len]:=this_byte(tdt);
  29.       event_len:=event_len+1;
  30.       advance(tdt);
  31.       end;
  32.     else
  33.       event_type:=MIDI;
  34.     end; { case }
  35.  
  36.   { fill in MIDI data bytes }
  37.   for i:=1 to nmdat(tdt.curr.running_status) do
  38.     begin
  39.     event.mess[event_len]:=this_byte(tdt);
  40.     event_len:=event_len+1;
  41.     advance(tdt);
  42.     end;
  43.   end; { with tdt.curr }
  44. return:
  45. end;
  46.  
  47. { Advance to the next Track Event in a Track Data Block
  48. }
  49. procedure next_track_event(var tdt:track_data_block);
  50. label
  51.   return;
  52. begin
  53. if (tdt.edat) then { end of data }
  54.   goto return;
  55. with tdt.curr do
  56.   begin
  57.   event_len:=1; { count event time }
  58.   case this_byte(tdt) of
  59.     TIMING_OVERFLOW:
  60.       begin
  61.       event_type:=OVFL;
  62.       event.time:=MAX_TIMING_COUNT;
  63.       advance(tdt);
  64.       goto return;
  65.       end;
  66.     0..239: { timing byte }
  67.       begin
  68.       event.time:=this_byte(tdt);
  69.       advance(tdt);
  70.       track_event_message(tdt);
  71.       end;
  72.     end; { case }
  73.   end; { with tdt.curr }
  74. return:
  75. end;
  76.  
  77. { Store a Track Event in a designated Track Data Block
  78. }
  79. procedure store_track_event(var tdo:track_data_block; 
  80.                 eblk:track_event_block);
  81. var
  82.   i : byte;  { index counter }
  83. begin
  84. case eblk.event.time of
  85.   MAX_TIMING_COUNT:
  86.     begin
  87.     tdo.tds[tdo.tds_ptr]:=TIMING_OVERFLOW;
  88.     advance(tdo);
  89.     end;
  90.   0..239:
  91.     begin
  92.     tdo.tds[tdo.tds_ptr]:=eblk.event.time;
  93.     advance(tdo);
  94.     for i:=1 to eblk.event_len - 1 do
  95.       begin
  96.       tdo.tds[tdo.tds_ptr]:=eblk.event.mess[i];
  97.       advance(tdo);
  98.       end;
  99.     end;
  100.   end; { case }
  101. end;
  102.  
  103. { Display a track event on the user console
  104. }
  105. procedure disp_event(eblk:track_event_block);
  106. var
  107.   i : byte;  { index counter }
  108. label return;
  109. begin
  110. with eblk do
  111.   begin
  112.   write(event.time:4);
  113.   if (event_len = 1) then
  114.       begin
  115.       write(' Timing Overflow':16);
  116.       goto return;
  117.       end;
  118.   if (event.mess[1] in [NOP,MEASURE_END,DATA_END]) then
  119.     begin
  120.     case event.mess[1] of
  121.       NOP :
  122.     begin
  123.     write('NOP':16);
  124.     goto return;
  125.     end;
  126.       MEASURE_END:
  127.     begin
  128.     write('Measure End':16);
  129.     goto return;
  130.     end;
  131.       DATA_END:
  132.     begin
  133.     write('Data End':16);
  134.     goto return;
  135.     end;
  136.     end; {case}
  137.     end; {if}
  138.   i:=1;
  139.   if (midi_status(event.mess[1])) then
  140.     begin
  141.     write(MIDI_MESS_TEXT[midi_cmnd(event.mess[1])]:16);
  142.     i:=i+1;
  143.     end
  144.   else
  145.     write(' ':16);
  146.   while (i <= (event_len - 1)) do
  147.     begin
  148.     write(event.mess[i]:4);
  149.     i:=i+1;
  150.     end;
  151.   end; { with eblk }
  152. return:
  153. writeln;
  154. end;
  155.  
  156. { Display all of the Track Events in a Track Data Block
  157. }
  158. procedure disp_track_data(var tdt:track_data_block);
  159. var
  160.   time : real;    { Actual time of current track event }
  161. begin
  162. time:=0.0;
  163. reset_track_data(tdt);
  164. while not(tdt.edat) do
  165.   begin
  166.   next_track_event(tdt);
  167.   time:=time+tdt.curr.event.time;
  168.   write( ((time*60)/(TIMEBASE*TEMPO)):8:3  );
  169.   disp_event(tdt.curr);
  170.   end;
  171. end;
  172.  
  173. );
  174.   time:=time+tdt.curr.event.time;
  175.   write( ((time*60)/(TIMEBASE*TEMPO)):8:3  );
  176.   disp_even